home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / asorts.zip / CMPSRT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  4KB  |  135 lines
  1. program cmpsrt;
  2. { Compares various sorting algorithms on random arrays }
  3.  
  4. {   -- as distributed, 100 random arrays of 100 integers are
  5.        generated and sorted against 6 different sorting methods.
  6.        When completed, the program reports the total number
  7.        of comparisons and exchanges that each method used.  }
  8.  
  9. { assumes "MONITOR" defined in ASORTS.TPU }
  10.  
  11. { NOTE: This program will not compile correctly with ASORTS.PAS
  12.   as you find it in the distribution package. ASORTS.PAS must be
  13.   compiled with the symbol "MONITOR" defined at compilation time.
  14.   There are several ways to do this:
  15.  
  16.   1. Edit ASORTS.PAS, removing the space between the left brace
  17. and the dollar sign in the "$define MONITOR" compiler directive.
  18. Then recompile the unit to a TPU.
  19.  
  20.   2. Load the ASORTS.PAS in the IDE. Under Options/Compiler,
  21. define the Conditional symbol "MONITOR". Then Compile/Build the
  22. TPU.
  23.  
  24.   3. With the command line compiler, TPC, include a "/DMONITOR"
  25. option on the command line.
  26.  
  27. While the MONITOR symbol is essential to compiling this
  28. demonstration program, you probably will not wish to incur the
  29. additional overhead when using ASORTS for your production
  30. programs. The original ASORTS.PAS, without the MONITOR symbol
  31. defined, is already configured to sort without external
  32. monitoring. }
  33.  
  34. uses asorts;
  35.  
  36. const
  37.   max = 100; { <-- change this to compare effect of array length }
  38.  
  39. type
  40.   list = array[1..max] of longint;
  41.  
  42. var
  43.   data,data2: ^list;
  44.   i,j: word;
  45.  
  46. const
  47.   numsorts = 6;
  48.   sortnames: array [1..numsorts] of string[9] = (
  49.       'HeapSort','QSort','SelSort','ShellSort',
  50.       'VQSort','VSelSort');
  51.  
  52.  
  53. var
  54.   currentsort:word;
  55.   compcount:array [1..numsorts] of longint;
  56.   swapcount:array [1..numsorts] of longint;
  57.  
  58. function longintcomp(var a,b):longint; far;
  59. var int1: longint absolute a;
  60.     int2: longint absolute b;
  61. begin
  62.   inc(compcount[currentsort]);
  63.   if int1<int2 then longintcomp:=-1
  64.   else if int1=int2 then longintcomp:=0
  65.   else longintcomp:=1; end;
  66.  
  67. procedure swapcounter; far; begin inc(swapcount[currentsort]) end;
  68.  
  69. function icompdata(a,b:longint):longint; far;
  70. begin
  71.    inc(compcount[currentsort]);
  72.    if data^[a]<data^[b] then icompdata:=-1
  73.    else if data^[a]=data^[b] then icompdata:=0
  74.    else icompdata:=1; end;
  75.  
  76. procedure iswapdata(a,b:longint); far;
  77. var c:longint;
  78. begin
  79.    inc(swapcount[currentsort]);
  80.    c:=data^[a]; data^[a]:=data^[b]; data^[b]:=c end;
  81.  
  82. procedure checksort;
  83. var i:word;
  84. begin
  85.   for i:=max downto 2 do
  86.       if data^[i]<data^[i-1] then begin
  87.          writeln;
  88.          writeln('Sort algorithm ',sortnames[currentsort],' failed!');
  89.          exit; end; end;
  90.  
  91.  
  92. begin {tstsrt2}
  93.   asorts.monitor:=swapcounter; { "MONITOR" must be defined in ASORTS.PAS }
  94.   new(data); new(data2);
  95.   for i:=1 to numsorts do begin
  96.       compcount[i]:=0; swapcount[i]:=0; end;
  97.   Randomize;
  98.  
  99. writeln;
  100. for j:= 1 to 100 do begin
  101.   write(#13,j,'':15);
  102.  
  103.   { this could be changed to compare the effect of different
  104.     "pre-orderings" on the sorting algorithms.  I'm not sure
  105.     what substitute you could make -- "almost sorted" arrays
  106.     are harder to generate than "random" arrays. }
  107.  
  108.   for i:=1 to max do begin
  109.       data2^[i]:=longint(random($7fff))-$3fff;
  110.       end;
  111.  
  112.   for currentsort:=1 to numsorts do begin
  113.       write(#13,j,sortnames[currentsort]:10,'':9);
  114.       data^:=data2^;
  115.       case currentsort of
  116.            1: heapsort(data^,max,sizeof(longint),longintcomp);
  117.            2: qsort(data^,max,sizeof(longint),longintcomp);
  118.            3: selsort(data^,max,sizeof(longint),longintcomp);
  119.            4: shellsort(data^,max,sizeof(longint),longintcomp);
  120.            5: vqsort(max,icompdata,iswapdata);
  121.            6: vselsort(max,icompdata,iswapdata);
  122.            end;
  123.       checksort; end; end;
  124.  
  125. writeln(#13,'':25);
  126. writeln('Sort Method':15,'Comparisons':15,'Exchanges':15);
  127. for currentsort:=1 to numsorts do begin
  128.     write(sortnames[currentsort]:15,
  129.           compcount[currentsort]:15);
  130.     if currentsort in [1,4] then
  131.        { for heap and shell, count three moves as a swap }
  132.        writeln((swapcount[currentsort] div 3):15)
  133.     else
  134.        writeln(swapcount[currentsort]:15); end; end.
  135.